home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / oberonv4 / oberon-src / system / reals.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-11-22  |  2.6 KB  |  90 lines
  1. Syntax10.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. Syntax24.Scn.Fnt
  6. (* AMIGA *)
  7. (* Notify Ralf for maintenance of Non-FPU source *)
  8. MODULE Reals;
  9. (* 11-Jun-1994/cn, use JRs routines. *)
  10. IMPORT
  11.     SYSTEM;
  12. PROCEDURE Ten* (e: INTEGER): REAL;
  13.  VAR r, power: LONGREAL;
  14. BEGIN r := 1;
  15.  power := 10;
  16.  WHILE e > 0 DO
  17.   IF ODD(e) THEN r := r * power END ;
  18.   power := power * power; e := e DIV 2
  19.  END ;
  20.  RETURN SHORT(r)
  21. END Ten;
  22. PROCEDURE TenL* (e: INTEGER): LONGREAL;
  23.  VAR r, power: LONGREAL;
  24. BEGIN r := 1;
  25.  power := 10;
  26.  LOOP
  27.   IF ODD(e) THEN r := r * power END ;
  28.   e := e DIV 2;
  29.   IF e <= 0 THEN RETURN r END ;
  30.   power := power * power
  31. END TenL;
  32. PROCEDURE Expo* (x: REAL): INTEGER;
  33. BEGIN RETURN SHORT(ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256)
  34. END Expo;
  35. PROCEDURE ExpoL* (x: LONGREAL): INTEGER;
  36. BEGIN RETURN SHORT(ASH(SYSTEM.VAL(LONGINT, x), -20) MOD 2048)
  37. END ExpoL;
  38. PROCEDURE SetExpo*(e: INTEGER; VAR x: REAL);
  39.  CONST expo = {23..30};
  40. BEGIN
  41.  SYSTEM.PUT(SYSTEM.ADR(x), SYSTEM.VAL(SET, x) - expo + SYSTEM.VAL(SET, ASH(LONG(e), 23)))
  42. END SetExpo;
  43. PROCEDURE SetExpoL*(e: INTEGER; VAR x: LONGREAL);
  44.  CONST expo = {52-32..62-32};
  45.  VAR h: SET;
  46. BEGIN
  47.  SYSTEM.GET(SYSTEM.ADR(x), h);
  48.  h := h - expo + SYSTEM.VAL(SET, ASH(LONG(e), 20));
  49.  SYSTEM.PUT(SYSTEM.ADR(x), h)
  50. END SetExpoL;
  51.     PROCEDURE Convert*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR);
  52.         VAR i, k: LONGINT;
  53.     BEGIN
  54.         i := ENTIER(x); k := 0;
  55.         WHILE k < n DO
  56.             d[k] := CHR(i MOD 10 + 48); i := i DIV 10; INC(k)
  57.         END
  58.     END Convert;
  59.     PROCEDURE ConvertL* (x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
  60.         i,k:INTEGER;
  61.         q:INTEGER; 
  62.     BEGIN
  63.         k:=0;
  64.         WHILE x>=10.0 DO x:=x/10.0; INC(k); END;
  65.         FOR i:=n TO k+1 DO d[i]:='0'; END;
  66.         FOR i:=k TO 0 BY -1 DO
  67.             q:=SHORT(ENTIER(x)); 
  68.             d[i]:=CHR(48+q);
  69.             x:=(x-q)*10.0;
  70.         END;
  71.     END ConvertL;
  72. PROCEDURE Unpack(VAR b, d: ARRAY OF SYSTEM.BYTE);
  73.  VAR i, k: SHORTINT;
  74. BEGIN i := 0;
  75.  WHILE i < LEN(b) DO
  76.   k := SHORT(ORD(SYSTEM.VAL(CHAR, b[i])) DIV 16);
  77.   IF k > 9 THEN d[i*2] := k + 55 ELSE d[i*2] := k + 48 END ;
  78.   k := SHORT(ORD(SYSTEM.VAL(CHAR, b[i])) MOD 16);
  79.   IF k > 9 THEN d[i*2+1] := k + 55 ELSE d[i*2+1] := k + 48 END ;
  80.   INC(i)
  81. END Unpack;
  82. PROCEDURE ConvertH* (y: REAL; VAR d: ARRAY OF CHAR);
  83. BEGIN Unpack(y, d)
  84. END ConvertH;
  85. PROCEDURE ConvertHL* (x: LONGREAL; VAR d: ARRAY OF CHAR);
  86. BEGIN Unpack(x, d)
  87. END ConvertHL;
  88. BEGIN
  89. END Reals.
  90.